home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / vsc92nov.zip / sym-prim.c < prev    next >
C/C++ Source or Header  |  1992-11-02  |  2KB  |  69 lines
  1. /*
  2.  * sym-prim.c -- Implementation of Scheme's primitive symbol procedures
  3.  *
  4.  * (C) m.b (Matthias Blume), Mon Jun  1 12:50:35 MET DST 1992, HUB/Ger
  5.  *         Humboldt-University of Berlin, Germany
  6.  */
  7.  
  8. # ident "@(#)sym-prim.c    (C) M.Blume, Humboldt-Uni Berlin, 1.2"
  9.  
  10. # include <stdlib.h>
  11. # include <string.h>
  12.  
  13. # include "storage.h"
  14. # include "Cont.h"
  15. # include "Symbol.h"
  16. # include "String.h"
  17. # include "Boolean.h"
  18. # include "type.h"
  19. # include "except.h"
  20. # include "tmpstring.h"
  21.  
  22. # include "builtins.tab"
  23.  
  24. /*ARGSUSED*/
  25. void ScmPrimitiveSymbolP (unsigned short argcnt)
  26. {
  27.   void *tmp = ScmPeek();
  28.  
  29.   ScmSetTop (ScmTypeOf (tmp) == ScmType (Symbol)
  30.         ? &ScmTrue
  31.         : &ScmFalse);
  32. }
  33.  
  34. /*ARGSUSED*/
  35. void ScmPrimitiveSymbolToString (unsigned short argcnt)
  36. {
  37.   void *tmp = ScmPeek();
  38.   ScmSymbol *sym;
  39.   ScmString *string;
  40.   unsigned len;
  41.   char *buf;
  42.  
  43.   if (ScmTypeOf (tmp) != ScmType (Symbol))
  44.     error ("bad arg to primitive procedure symbol->string: %w", tmp);
  45.   sym = tmp;
  46.   buf = tmpstring (sym->array, sym->length);
  47.   len = sym->length;
  48.   string = getmem (ScmType (String), sizeof (ScmString) + len - 1);
  49.   string->length = len;
  50.   memcpy (string->array, buf, len);
  51.   ScmSetTop (string);
  52. }
  53.  
  54. /*ARGSUSED*/
  55. void ScmPrimitiveStringToSymbol (unsigned short argcnt)
  56. {
  57.   void *tmp = ScmPeek();
  58.   ScmSymbol *sym;
  59.   ScmString *string;
  60.   char *buf;
  61.  
  62.   if (ScmTypeOf (tmp) != ScmType (String))
  63.     error ("bad arg to primitive procedure string->symbol: %w", tmp);
  64.   string = tmp;
  65.   buf = tmpstring (string->array, string->length);
  66.   sym = ScmMakeSymbol (buf, string->length);
  67.   ScmSetTop (sym);
  68. }
  69.